VERSION 5.00
Begin VB.Form frmRMsg 
   Caption         =   "Receiving Messages from MQ"
   ClientHeight    =   3195
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3195
   ScaleWidth      =   4680
   StartUpPosition =   3  'Windows Default
End
Attribute VB_Name = "frmRMsg"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public Receiving_Q_Name
Public Q_Manager_Name
'Public csReg_RequestKey 'Added this (Declared this variable.)
Public Requestkey As String
Public ReceiveErr As String
'Fikile: Commented it out.
'Private Const csReg_RequestKey = "Software\Mindkey\KeyTax\QManager"
Private Const csReg_ErrorFile = "Software\Mindkey\KeyTax\ErrorFile"

Public Counter
Private Sub Form_Load()
    
    Dim mqMessage As String
    Dim X As clsUpdateInterface
    Dim FileName
    Dim xmldoc As MSXML2.DOMDocument
    
    frmSplash.Show
    DoEvents
    Me.Hide
    Set X = New clsUpdateInterface
    On Error GoTo StopProcess
    

        SetProgress "Setup Request Key"
       Call SetUp_RequestKey

        SetProgress "Poll receiving queue loop while there is messages"
        mqMessage = "Start"
        Counter = 0
                
        SetProgress "Get messages from MQ"
        
        Do While Len(Trim(mqMessage)) > 0
            DoEvents
            mqMessage = ""
            
            
            mqMessage = Get_Message
            
            If Len(Trim(mqMessage)) > 0 Then
                DoEvents
                Counter = Counter + 1
                
                Call X.Update_Interface(CStr(mqMessage))
                
                frmSplash.lMsg.Caption = "Downloading  message " & Counter
                DoEvents
            End If
        Loop
        
        'If SQL is down,
        FileName = Dir("C:\Mindkey\Keytax\Error\In Progress\*.xml")
        
        Set xmldoc = New MSXML2.DOMDocument
        
        Do While FileName <> ""
            Call xmldoc.Load("C:\Mindkey\Keytax\Error\In Progress\" & FileName)
            mqMessage = xmldoc.xml
            Call X.Update_Interface(CStr(mqMessage))
            frmSplash.lMsg.Caption = "Downloading  message " & Counter
            Kill ("C:\Mindkey\Keytax\Error\In Progress\" & FileName)
            FileName = Dir
        Loop
        
    frmSplash.lMsg.Caption = "Messages downloaded " & Counter
    DoEvents
    
    End
    Exit Sub
    
StopProcess:
    MsgBox (Err.Number & "--" & Err.Description & " " & Now & " (" & frmSplash.lblProgress.Caption & ")")
    
    FileUName = ReceiveErr & Format(Now, "YYYYMMDD") & ".txt"
    Open FileUName For Append As #1
        Print #1, Err.Number & "--" & Err.Description & " " & Now & " (" & frmSplash.lblProgress.Caption & ")"
    Close #1
    
    frmSplash.Hide
    End
    
End Sub
Sub SetUp_RequestKey()

'Setup requestkey from registry
    Requestkey = GetSettingC(csReg_RequestKey, "MQREC_NAME")
    ReceiveErr = GetSettingC(csReg_ErrorFile, "ReceiveErr")
    
End Sub
Function Get_Message() As String
    SetProgress "Get_Message() IN"
    
    Dim clsMq As clsMqSeries
    Dim GInd As Integer
    Dim Data As String
    Dim MqCode
    
    Set clsMq = New clsMqSeries

    Get_Message = ""

SetProgress "Use registry to setup key for different systems one system per machine"
   Call Get_Q_M_Name(Requestkey)
   
SetProgress "Open Queue Manager"
    MqCode = clsMq.MQ_Op_Conn(Q_Manager_Name)
    
    If IsAcceptableMQErrorCode(MqCode) Then
SetProgress "Open Receive Queue"
        MqCode = clsMq.MQ_Get_Open("P", Requestkey)
    End If
    
    'IMPORTANT:
    'if MqCode <> 0, then look up the error code in the MQERR table in TOAD
    'User ID=F_maint;Password=f_maint;Data Source=idbdev"
    
SetProgress "Get message from receive queue"
    If IsAcceptableMQErrorCode(MqCode) Then
        MqCode = clsMq.MQ_Get_Msg(Data, Requestkey, "", "", "P")
        
        SetProgress "If the returncode we got back is a not a valid one, i.e. if it's acceptable. IsAcceptableMQErrorCode(" & MqCode & "): " & IsAcceptableMQErrorCode(MqCode)
        
        If IsAcceptableMQErrorCode(MqCode) Then
            SetProgress Data
            Get_Message = Data
        Else
            Get_Message = ""
        End If
    End If
    
SetProgress "Close Connection"
    Call clsMq.MQ_Close_Conn

End Function
Sub Get_Q_M_Name(Requestkey As String)
    Q_Manager_Name = GetSettingC(csReg_RequestKey, "MQREC_Q_MANAGER_NAME") '"LMD1UPAP"
    Receiving_Q_Name = GetSettingC(csReg_RequestKey, "MQREC_RECEIVING_Q_NAME") '"LQ.LCB.LCBTOKEYTAX.01"
End Sub

Sub SetProgress(ByVal message As String)
    'MsgBox (message)
    frmSplash.lblProgress.Caption = message
    
End Sub
